home *** CD-ROM | disk | FTP | other *** search
/ PC Media 2 / PC MEDIA CD02.iso / share / prog / tpsorts / heap.tur < prev    next >
Encoding:
Text File  |  1985-10-04  |  2.4 KB  |  75 lines
  1.    PROCEDURE sort_data_on_key(
  2.     VAR key : vector_1;
  3.     VAR data : vector_2;
  4.     VAR record_count : INTEGER);
  5.      VAR
  6.       finished
  7.                                          : BOOLEAN;
  8.       key_index_1,
  9.       key_index_2,
  10.       left,
  11.       right,
  12.       tem_data
  13.                                          : INTEGER;
  14.       tem_key
  15.                                          : REAL;
  16.      BEGIN
  17.        left:=record_count DIV 2;
  18.        left:=left+1;
  19.        right:=record_count;
  20.        finished:=FALSE;
  21.        tem_key:=key[1];
  22.        tem_data:=data[1];
  23.        WHILE (right > 1) DO
  24.          BEGIN
  25.            IF left > 1 THEN
  26.              BEGIN
  27.                left:=left-1;
  28.                tem_key:=key[left];
  29.                tem_data:=data[left]
  30.              END
  31.            ELSE
  32.              BEGIN
  33.                tem_key:=key[right];
  34.                tem_data:=data[right];
  35.                key[right]:=key[1];
  36.                data[right]:=data[1];
  37.                right:=right-1
  38.              END;
  39.            IF right > 1 THEN
  40.              BEGIN
  41.                key_index_2:=left;
  42.                finished:=FALSE;
  43.                WHILE (NOT finished) DO
  44.                  BEGIN
  45.                    key_index_1:=key_index_2;
  46.                    key_index_2:=2*key_index_2;
  47.                    IF key_index_2 > right THEN
  48.                      finished:=TRUE
  49.                    ELSE
  50.                      BEGIN
  51.                        IF key_index_2 <> right THEN
  52.                          BEGIN
  53.                            IF key[key_index_2]
  54.                             < key[key_index_2+1] THEN
  55.                              key_index_2:=key_index_2+1
  56.                          END;
  57.                        IF tem_key >= key[key_index_2] THEN
  58.                          finished:=TRUE
  59.                        ELSE
  60.                          BEGIN
  61.                            key[key_index_1]
  62.                             :=key[key_index_2];
  63.                            data[key_index_1]
  64.                             :=data[key_index_2]
  65.                          END
  66.                      END
  67.                  END;
  68.                data[key_index_1]:=tem_data;
  69.                key[key_index_1]:=tem_key
  70.              END
  71.          END;
  72.        key[1]:=tem_key;
  73.        data[1]:=tem_data
  74.      END;
  75.